Shareware Grab Bag/Shareware Grab Bag.iso/050/rotater.arc/ROTATER.PAS

Pascal/Delphi Source File | 1985-12-23 | 7.7 KB | 308 lines

{Program by Stan Mros written in Turbo Pascal}
{For IBM color graphics card in Turbo Graphix Toolbox}
{Free public distribution encouraged}

program rotater;
{$I typedef.sys}
{$I graphix.sys}
{$I kernel.sys}
{$I windows.sys}


const

    radians: real=0.0785398; {1/80 of a rotation}
    radiansn: real=6.2046456; {-1/80 of a rotation}
    sqrof2: real=1.414214;   {used in displaying pts.}
    maxpts=100;
    maxconnect=150;
    numofrotations=80;

type
    coordinate=real;
    distance=real;

var
    xplot1,yplot1,xplot2,yplot2:array [1..maxconnect] of integer;
    xt,yt,zt,xcor,ycor,zcor:array [1..maxpts] of coordinate;
    pt1,pt2:array [1..maxconnect] of integer;
    xlow,ylow,xhigh,yhigh:integer;

    choice,rotation:char;
    numofpts,numofconnect,counter:integer;
    xangle,yangle,zangle,cosofang,cosofang90:real;

procedure setup;
begin;
xhigh:=-1000;
yhigh:=-1000;
xlow:=1000;
ylow:=1000;
xangle:=0;
yangle:=0;
zangle:=0;
end;

procedure rotatex;
var
   count2:integer;
begin;
      for count2:=1 to numofpts do begin;
          zcor[count2]:=trunc(zt[count2]*cos(xangle)-yt[count2]*sin(xangle));
          ycor[count2]:=trunc(zt[count2]*sin(xangle)+yt[count2]*cos(xangle));
          xcor[count2]:=trunc(xt[count2]);
      end;
end;

procedure rotatey;
var
   count2:integer;
begin;
      for count2:=1 to numofpts do begin;
          xcor[count2]:=trunc(xt[count2]*cos(yangle)-zt[count2]*sin(yangle));
          zcor[count2]:=trunc(xt[count2]*sin(yangle)+zt[count2]*cos(yangle));
          ycor[count2]:=trunc(yt[count2]);
      end;
end;

procedure rotatez;
var
   count2:integer;
begin;
      for count2:=1 to numofpts do begin;
          ycor[count2]:=trunc(yt[count2]*cos(zangle)-xt[count2]*sin(zangle));
          xcor[count2]:=trunc(yt[count2]*sin(zangle)+xt[count2]*cos(zangle));
          zcor[count2]:=trunc(zt[count2]);
      end;
end;

procedure rotate;
begin;
    case rotation of
         '1':begin;
                 xangle:=xangle+radians;
                 rotatex;
             end;
         '2':begin;
                 xangle:=xangle+radiansn;
                 rotatex;
             end;
         '3':begin;
                 yangle:=yangle+radians;
                 rotatey;
             end;
         '4':begin;
                 yangle:=yangle+radiansn;
                 rotatey;
             end;
         '5':begin;
                 zangle:=zangle+radians;
                 rotatez;
             end;
         '6':begin;
                 zangle:=zangle+radiansn;
                 rotatez;
             end;
         end;
end;

procedure findpoints;
var
   loop1:integer;
begin;
for loop1:=1 to numofconnect do begin;
        xplot1[loop1]:=trunc(xcor[pt1[loop1]]-trunc(ycor[pt1[loop1]]/sqrof2));
        yplot1[loop1]:=trunc(zcor[pt1[loop1]]+trunc(ycor[pt1[loop1]]/sqrof2));
        xplot2[loop1]:=trunc(xcor[pt2[loop1]]-trunc(ycor[pt2[loop1]]/sqrof2));
        yplot2[loop1]:=trunc(zcor[pt2[loop1]]+trunc(ycor[pt2[loop1]]/sqrof2));
end;
end;

procedure findmaxmin;
var
   loop1,loop2:integer;
begin;
setup;
for loop2:=1 to numofrotations do begin;
    rotate;
    for loop1:=1 to numofconnect do begin;
        findpoints;
        if xplot1[loop1]<xlow then xlow:=xplot1[loop1];
        if xplot2[loop1]<xlow then xlow:=xplot2[loop1];
        if xplot1[loop1]>xhigh then xhigh:=xplot1[loop1];
        if xplot2[loop1]>xhigh then xhigh:=xplot2[loop1];
        if yplot1[loop1]<ylow then ylow:=yplot1[loop1];
        if yplot2[loop1]<ylow then ylow:=yplot2[loop1];
        if yplot1[loop1]>yhigh then yhigh:=yplot1[loop1];
        if yplot2[loop1]>yhigh then yhigh:=yplot2[loop1];
    end;
end;
defineworld(1,xlow,ylow,xhigh,yhigh);
end;

procedure drawptsinwindow;
     var loop1,loop2:integer;
begin;
setup;
    for loop1:=1 to numofrotations do begin;
    definewindow(loop1,trunc(xmaxglb*1/5),trunc(ymaxglb*1/5),trunc(xmaxglb*2/5),trunc(ymaxglb*2/5));
    selectworld(1);
    selectwindow(loop1);
    rotate;
    findpoints;
    clearscreen;
            for loop2:=1 to numofconnect do begin;
            drawline(xplot1[loop2],yplot1[loop2],xplot2[loop2],yplot2[loop2]);
        end;
        storewindow(loop1);
    end;
end;

procedure displaypts;
var
   rot,loop1,loop2:integer;
begin;
clearscreen;
gotoxy(1,1);
write('Enter the number of complete rotations:');readln(rot);
entergraphic;
clearscreen;
for loop2:=1 to rot do begin;
    for loop1:=1 to numofrotations do begin;
        restorewindow(loop1,0,0);
        end;
    end;
leavegraphic;
end;

procedure rotateandsave;
begin;
      entergraphic;
      findmaxmin;
      drawptsinwindow;
      leavegraphic;
end;

procedure enterrotations;
var
   loop1:integer;
   rot:char;
begin;
clearscreen;
gotoxy(1,1);writeln('   types of rotations:');
writeln('');
writeln('(1) Counter clockwise around X axis');
writeln('(2) Clockwise around X axis');
writeln('(3) Counter clockwise around Y axis');
writeln('(4) Clockwise around Y axis');
writeln('(5) Counter clockwise around Z axis');
writeln('(6) Clockwise around Z axis');
gotoxy(5,16);write('Enter the number of the rotation:');
      read(kbd,rotation);
end;

procedure enterpts;
begin;
repeat;
      gotoxy(4,4);
      write('enter the number of points: ');
      readln(numofpts);
until numofpts<maxpts;
for counter:=1 to numofpts do begin;
    gotoxy(4,6);write('entering values for point ');write(counter);
    gotoxy(7,9);write('enter X value:');readln(xt[counter]);
    gotoxy(7,10);write('enter Y value:');readln(yt[counter]);
    gotoxy(7,11);write('enter Z value:');readln(zt[counter]);
    gotoxy(21,9);write('     ');
    gotoxy(21,10);write('     ');
    gotoxy(21,11);write('     ');
end;
end;

procedure enterconnections;
begin;
repeat;
       gotoxy(5,4);
       write('enter the number of connections:');
       readln(numofconnect);
until numofconnect<=maxconnect;
for counter:=1 to numofconnect do begin;
    gotoxy(6,6);write('connection number ');
    write(counter);
    gotoxy(8,8);write('first point for connection: ');
    readln(pt1[counter]);
    gotoxy(8,9);write('second point for connection: ');
    readln(pt2[counter]);
    gotoxy(34,8);writeln('     ');
    gotoxy(35,9);writeln('     ');
end;
end;

procedure drawmenu;
begin;
clearscreen;
gotoxy(10,3);writeln('(1) Enter the points');
gotoxy(10,5);writeln('(2) Enter the connections');
gotoxy(10,7);writeln('(3) Enter the rotation pattern');
gotoxy(10,9);writeln('(4) Rotate and save in windows');
gotoxy(10,11);writeln('(5) display points in windows');
gotoxy(10,13);writeln('(6) save window stack');
gotoxy(10,15);writeln('(7) load window stack');
gotoxy(10,17);writeln('(8) quit');
gotoxy(20,19);writeln('enter choice >');
end;

procedure saveit;
var
   stackname:string [8];
begin;
clearscreen;
gotoxy(1,1);
write('Enter name to be given to stack (no extension required):');
readln(stackname);
savewindowstack(stackname);
end;

procedure loadit;
var
   stackname:string [8];
begin;
clearscreen;
gotoxy(1,1);
write('Enter name of existing stack (no extension required):');
readln(stackname);
loadwindowstack(stackname);
end;

procedure menu;
begin;
drawmenu;
choice:='0';
repeat;
       read(kbd,choice);
       gotoxy(34,19);write(choice);
       until choice in ['1','2','3','4','5','6','7','8'];
clearscreen;
case choice of
     '1':enterpts;
     '2':enterconnections;
     '3':enterrotations;
     '4':rotateandsave;
     '5':displaypts;
     '6':saveit;
     '7':loadit;
end;
clearscreen;
end;


begin; {program rotater.pas}
initgraphic;
leavegraphic;
drawmenu;
repeat;
       menu;
until choice='8';
leavegraphic;
end.